home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / richto1a / frmmain.frm next >
Text File  |  1999-10-03  |  10KB  |  290 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "Rich To HTML"
  5.    ClientHeight    =   3600
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   4245
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3600
  11.    ScaleWidth      =   4245
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.TextBox txtHTML 
  14.       BeginProperty Font 
  15.          Name            =   "Arial"
  16.          Size            =   9.75
  17.          Charset         =   0
  18.          Weight          =   400
  19.          Underline       =   0   'False
  20.          Italic          =   0   'False
  21.          Strikethrough   =   0   'False
  22.       EndProperty
  23.       Height          =   735
  24.       Left            =   0
  25.       MultiLine       =   -1  'True
  26.       ScrollBars      =   2  'Vertical
  27.       TabIndex        =   4
  28.       Top             =   2040
  29.       Width           =   4215
  30.    End
  31.    Begin VB.CommandButton cmdConvert 
  32.       Caption         =   "Convert"
  33.       Height          =   375
  34.       Left            =   1560
  35.       TabIndex        =   1
  36.       Top             =   1200
  37.       Width           =   1215
  38.    End
  39.    Begin RichTextLib.RichTextBox rtbRichText 
  40.       Height          =   735
  41.       Left            =   0
  42.       TabIndex        =   0
  43.       Top             =   240
  44.       Width           =   4215
  45.       _ExtentX        =   7435
  46.       _ExtentY        =   1296
  47.       _Version        =   393217
  48.       TextRTF         =   $"frmMain.frx":0000
  49.    End
  50.    Begin VB.Label lblHTML 
  51.       BackStyle       =   0  'Transparent
  52.       Caption         =   "HTML:"
  53.       Height          =   255
  54.       Left            =   0
  55.       TabIndex        =   3
  56.       Top             =   1760
  57.       Width           =   615
  58.    End
  59.    Begin VB.Line lneSep2 
  60.       BorderColor     =   &H80000003&
  61.       Index           =   1
  62.       X1              =   0
  63.       X2              =   4200
  64.       Y1              =   1670
  65.       Y2              =   1670
  66.    End
  67.    Begin VB.Line lneSep2 
  68.       BorderColor     =   &H00FFFFFF&
  69.       Index           =   0
  70.       X1              =   0
  71.       X2              =   4200
  72.       Y1              =   1680
  73.       Y2              =   1680
  74.    End
  75.    Begin VB.Line lneSep 
  76.       BorderColor     =   &H80000003&
  77.       Index           =   1
  78.       X1              =   0
  79.       X2              =   4200
  80.       Y1              =   1070
  81.       Y2              =   1070
  82.    End
  83.    Begin VB.Line lneSep 
  84.       BorderColor     =   &H00FFFFFF&
  85.       Index           =   0
  86.       X1              =   0
  87.       X2              =   4200
  88.       Y1              =   1080
  89.       Y2              =   1080
  90.    End
  91.    Begin VB.Label lblRichText 
  92.       BackStyle       =   0  'Transparent
  93.       Caption         =   "Rich Text:"
  94.       Height          =   255
  95.       Left            =   0
  96.       TabIndex        =   2
  97.       Top             =   0
  98.       Width           =   1215
  99.    End
  100. End
  101. Attribute VB_Name = "frmMain"
  102. Attribute VB_GlobalNameSpace = False
  103. Attribute VB_Creatable = False
  104. Attribute VB_PredeclaredId = True
  105. Attribute VB_Exposed = False
  106. '**********************************************************
  107. '*            Rich To HTML by Joseph Huntley              *
  108. '*               joseph_huntley@email.com                 *
  109. '*                http://joseph.vr9.com                   *
  110. '*                                                        *
  111. '*  Made:  October 4, 1999                                *
  112. '*  Level: Beginner                                       *
  113. '**********************************************************
  114. '*   The form here are only used to demonstrate how to    *
  115. '* use the function 'RichToHTML'. You may copy the        *
  116. '* function into your project for use. If you need any    *
  117. '* help please e-mail me.                                 *
  118. '**********************************************************
  119. '* Notes: None                                            *
  120. '**********************************************************
  121.  
  122. Function RichToHTML(rtbRichTextBox As RichTextLib.RichTextBox, Optional lngStartPosition As Long, Optional lngEndPosition As Long) As String
  123. '**********************************************************
  124. '*            Draw Percent by Joseph Huntley              *
  125. '*               joseph_huntley@email.com                 *
  126. '*                http://joseph.vr9.com                   *
  127. '**********************************************************
  128. '*   You may use this code freely as long as credit is    *
  129. '* given to the author, and the header remains intact.    *
  130. '**********************************************************
  131.  
  132. '--------------------- The Arguments -----------------------
  133. 'rtbRichTextBox     - The rich textbox control to convert.
  134. 'lngStartPosition   - The character position to start from.
  135. 'lngEndPosition     - The character position to end at.
  136. '-----------------------------------------------------------
  137. 'Returns:     The rich text converted to HTML.
  138.  
  139. 'Description: Converts rich text to HTML.
  140.  
  141. Dim blnBold As Boolean, blnUnderline As Boolean, blnStrikeThru As Boolean
  142. Dim blnItalic As Boolean, strLastFont As String, lngLastFontColor As Long
  143. Dim strHTML As String, lngColor As Long, lngRed As Long, lngGreen As Long
  144. Dim lngBlue As Long, lngCurText As Long, strHex As String, intLastAlignment As Integer
  145.  
  146. Const AlignLeft = 0, AlignRight = 1, AlignCenter = 2
  147.  
  148. 'check for lngStartPosition ad lngEndPosition
  149.  
  150. If IsMissing(lngStartPosition&) Then lngStartPosition& = 0
  151. If IsMissing(lngEndPosition&) Then lngEndPosition& = Len(rtbRichTextBox.Text)
  152.  
  153. lngLastFontColor& = -1 'no color
  154.  
  155.    For lngCurText& = lngStartPosition& To lngEndPosition&
  156.        rtbRichTextBox.SelStart = lngCurText&
  157.        rtbRichTextBox.SelLength = 1
  158.    
  159.           If intLastAlignment% <> rtbRichTextBox.SelAlignment Then
  160.              intLastAlignment% = rtbRichTextBox.SelAlignment
  161.               
  162.                 Select Case rtbRichTextBox.SelAlignment
  163.                    Case AlignLeft: strHTML$ = strHTML$ & "<p align=left>"
  164.                    Case AlignRight: strHTML$ = strHTML$ & "<p align=right>"
  165.                    Case AlignCenter: strHTML$ = strHTML$ & "<p align=center>"
  166.                 End Select
  167.                 
  168.           End If
  169.    
  170.           If blnBold <> rtbRichTextBox.SelBold Then
  171.                If rtbRichTextBox.SelBold = True Then
  172.                  strHTML$ = strHTML$ & "<b>"
  173.                Else
  174.                  strHTML$ = strHTML$ & "</b>"
  175.                End If
  176.              blnBold = rtbRichTextBox.SelBold
  177.           End If
  178.  
  179.           If blnUnderline <> rtbRichTextBox.SelUnderline Then
  180.                If rtbRichTextBox.SelUnderline = True Then
  181.                  strHTML$ = strHTML$ & "<u>"
  182.                Else
  183.                  strHTML$ = strHTML$ & "</u>"
  184.                End If
  185.              blnUnderline = rtbRichTextBox.SelUnderline
  186.           End If
  187.    
  188.  
  189.           If blnItalic <> rtbRichTextBox.SelItalic Then
  190.                If rtbRichTextBox.SelItalic = True Then
  191.                  strHTML$ = strHTML$ & "<i>"
  192.                Else
  193.                  strHTML$ = strHTML$ & "</i>"
  194.                End If
  195.              blnItalic = rtbRichTextBox.SelItalic
  196.           End If
  197.  
  198.  
  199.           If blnStrikeThru <> rtbRichTextBox.SelStrikeThru Then
  200.                If rtbRichTextBox.SelStrikeThru = True Then
  201.                  strHTML$ = strHTML$ & "<s>"
  202.                Else
  203.                  strHTML$ = strHTML$ & "</s>"
  204.                End If
  205.              blnStrikeThru = rtbRichTextBox.SelStrikeThru
  206.           End If
  207.  
  208.          If strLastFont$ <> rtbRichTextBox.SelFontName Then
  209.             strLastFont$ = rtbRichTextBox.SelFontName
  210.             strHTML$ = strHTML$ + "<font face=""" & strLastFont$ & """>"
  211.          End If
  212.  
  213.          If lngLastFontColor& <> rtbRichTextBox.SelColor Then
  214.             lngLastFontColor& = rtbRichTextBox.SelColor
  215.             
  216.             ''Get hexidecimal value of color
  217.             strHex$ = Hex(rtbRichTextBox.SelColor)
  218.             strHex$ = String$(6 - Len(strHex$), "0") & st